home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / construc / INDEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-01-06  |  10.1 KB  |  386 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V+,X+}
  2. unit Index;
  3. {$DEFINE ANALYSE}
  4. {.$DEFINE BLOCK}
  5. interface
  6. const
  7.   IdentSet = ['A'..'Z','a'..'z','0'..'9','-','+'];
  8.   StartSet = ['A'..'Z','a'..'z'];
  9.  
  10. const
  11.   MaxPage = 255;
  12.   MaxHits = 100; { out of 214 webpages }
  13.  
  14. type
  15.   TNumPage = 0..MaxPage; { max number of webpages in site }
  16.   TURLPage = ShortString { assuming URL <= 255 characters };
  17.  
  18. var
  19.   WebPages: TNumPage = 0;
  20.   WebPage: Array[TNumPage] of TURLPage;
  21.   Titles: Array[TNumPage] of TURLPage;
  22.  
  23. const
  24.   MaxKeyword = 31-8;
  25.  
  26. type
  27.   TKeyword = String[MaxKeyword];
  28.   TPageSet = Set of TNumPage;
  29.  
  30. type
  31.   TNode = record
  32.     Keyword: TKeyword; { 32 bytes }
  33.     URLs: TPageSet;    { 32 bytes }
  34.   end {TNode};
  35.  
  36.   TTree = class
  37.     Node: TNode;
  38.     constructor Create(const Keyword: TKeyword; WebPage: TNumPage);
  39.     destructor Destroy; override;
  40.   private
  41.     Prev,Next: TTree;
  42.   end {TTree};
  43.  
  44. var
  45.   Keywords: Integer = 0;
  46.   root: TTree = nil;
  47.  
  48. type
  49. {$IFDEF BLOCK}
  50.   TIndexFile = File;
  51. {$ELSE}
  52.   TIndexFile = File of TNode;
  53. {$ENDIF}
  54.  
  55. implementation
  56. uses
  57.   DrBobSys, SysUtils;
  58.  
  59.   constructor TTree.Create(const Keyword: TKeyword; WebPage: TNumPage);
  60.   begin
  61.     inherited Create;
  62.     Inc(Keywords); // keep track of number of keywords
  63.     Prev := nil;
  64.     Next := nil;
  65.   {$IFNDEF BLOCK}
  66.     FillChar(Node.Keyword,MaxKeyword+1,#0); { sparse }
  67.   {$ENDIF}
  68.     Node.Keyword := Keyword;
  69.     Node.URLs := [WebPage]
  70.   end {Create};
  71.  
  72.   destructor TTree.Destroy;
  73.   begin
  74.     if Prev <> nil then Prev.Free;
  75.     if Next <> nil then Next.Free;
  76.     inherited Destroy
  77.   end {Destroy};
  78.  
  79.   procedure AddKeyword(const Keyword: TKeyword; WebPage: TNumPage);
  80.   var
  81.     tmp: TTree;
  82.   begin
  83.     if root = nil then
  84.       root := TTree.Create(Keyword,WebPage)
  85.     else { search }
  86.     begin
  87.       tmp := root;
  88.       repeat
  89.         if tmp.Node.Keyword > Keyword then
  90.         begin
  91.           if tmp.Prev = nil then
  92.             tmp.Prev := TTree.Create(Keyword,WebPage);
  93.           tmp := tmp.Prev
  94.         end
  95.         else
  96.           if tmp.Node.Keyword < Keyword then
  97.           begin
  98.             if tmp.Next = nil then
  99.               tmp.Next := TTree.Create(Keyword,WebPage);
  100.             tmp := tmp.Next
  101.           end
  102.       until tmp.Node.Keyword = Keyword;
  103.       tmp.Node.URLs := tmp.Node.URLs + [WebPage]
  104.     end
  105.   end {AddKeyword};
  106.  
  107.   procedure ScanPage(const FileName: ShortString; WebPage: TNumPage);
  108.   var
  109.     f: Text;
  110.     NotInTag: Boolean;
  111.     Keyword: ShortString;
  112.     Len: Byte absolute Keyword;
  113.   begin
  114.     assign(f,FileName);
  115.     reset(f);
  116.     if IOResult = 0 then
  117.     begin
  118.       writeln('<LI><B>',FileName,'</B>');
  119.       Len := 0;
  120.       while (Len = 0) and not eof(f) do
  121.       begin
  122.         readln(f,Keyword);
  123.         if Pos('<TITLE>',UpperCase(Keyword)) > 0 then
  124.         begin
  125.           Delete(Keyword,1,Pos('<TITLE>',UpperCase(Keyword))+6);
  126.           Delete(Keyword,Pos('</TITLE>',UpperCase(Keyword)),255)
  127.         end
  128.         else
  129.           Len := 0
  130.       end;
  131.       if Len = 0 then writeln('- <I>has no title or description...</I>')
  132.       else
  133.         Titles[WebPages] := Keyword; { Title of Webpage }
  134.       NotInTag := True;
  135.       close(f);
  136.       assign(f,FileName);
  137.       reset(f); { second time }
  138.       while not eof(f) do
  139.       begin
  140.         Len := 0;
  141.         while not eoln(f) do
  142.         begin
  143.           Inc(Len);
  144.           read(f,Keyword[Len]);
  145.           if not (Keyword[Len] in IdentSet) then
  146.           begin
  147.             Dec(Len);
  148.             if (Len > 2) and NotInTag then
  149.               if (Len <= MaxKeyWord) then
  150.                 AddKeyword(LowerCase(Keyword),WebPage)
  151.               else
  152.                 writeln('<BR>skipped keyword: ',Keyword);
  153.             if Keyword[Len+1] = '>' then NotInTag := True
  154.             else
  155.               if Keyword[Len+1] = '<' then NotInTag := False;
  156.             Len := 0
  157.           end
  158.           else
  159.             if (Len = 1) then { start with letter ?? }
  160.               if not (Keyword[1] in StartSet) then Len := 0
  161.         end;
  162.         if (Len > 2) and NotInTag then
  163.           if (Len <= MaxKeyWord) then
  164.             AddKeyword(LowerCase(Keyword),WebPage)
  165.           else
  166.             writeln('<BR>skipped keyword: ',Keyword);
  167.         readln(f)
  168.       end;
  169.       close(f)
  170.     end
  171.     else
  172.       writeln('<LI>',FileName); { failed to open }
  173.   end {ScanPage};
  174.  
  175.   procedure ScanPages(const Path: ShortString);
  176.   var
  177.     SRec: TSearchRec;
  178.   begin
  179.     if FindFirst('*.*', faDirectory, SRec) = 0 then
  180.     repeat
  181.       if (SRec.Attr AND faDirectory) = faDirectory then
  182.       begin
  183.         if (SRec.Name[1] <> '.') then { skip '.' and '..' }
  184.         if Pos('_vti',SRec.Name) = 0 then { _vti_cnf etc. }
  185.         begin
  186.           ChDir(SRec.Name);
  187.           if IOResult = 0 then
  188.           begin
  189.             writeln('<LI><I>',SRec.Name,'</I>');
  190.             writeln('<UL>');
  191.             ScanPages(Path+'/'+SRec.Name);
  192.             writeln('</UL>');
  193.             ChDir('..')
  194.           end
  195.           else
  196.             writeln('<LI><I>',SRec.Name,'</I> - locked')
  197.         end
  198.       end
  199.       else { file }
  200.       if ((Pos('.HTM',UpperCase(SRec.Name)) > 0) or
  201.           (Pos('.ASP',UpperCase(SRec.Name)) > 0)) and
  202.           (Pos('.bak',SRec.Name) = 0) then
  203.       begin
  204.         WebPage[WebPages] := Path + '/' + SRec.Name;
  205.         ScanPage(SRec.Name,WebPages);
  206.         Inc(WebPages)
  207.       end
  208.     until FindNext(SRec) <> 0;
  209.     FindClose(SRec)
  210.   end {ScanPages};
  211.  
  212.   function Pages(PageSet: TPageSet): Byte;
  213.   var
  214.     B: Byte;
  215.   begin
  216.     Result := 0;
  217.     for B := 0 to MaxPage do
  218.       if B in PageSet then Result := Result + 1
  219.   end {Pages};
  220.  
  221.   procedure WriteTree(var IndexFile: TIndexFile; root: TTree);
  222.   begin
  223.     if root.Prev <> nil then WriteTree(IndexFile,root.Prev);
  224.     if (Length(root.node.Keyword) > 3) or
  225.        (Pages(root.node.URLs) <= MaxHits) then
  226.     begin
  227.     {$IFDEF BLOCK}
  228.       BlockWrite(IndexFile,root.Node.Keyword[0],Ord(root.node.Keyword[0])+1);
  229.       BlockWrite(IndexFile,root.Node.URLs,SizeOf(root.Node.URLs));
  230.     {$ELSE}
  231.       write(IndexFile,root.Node);
  232.     {$ENDIF}
  233.       Inc(Keywords) { counter }
  234.     end
  235.     else
  236.       writeln('<LI>',root.Node.Keyword);
  237.     if root.Next <> nil then WriteTree(IndexFile,root.Next)
  238.   end {WriteTree};
  239.  
  240.   function WalkTreeLength(len,hits: Integer; root: TTree): Integer;
  241.   { find words of Length len, that have <= hits pages }
  242.   begin
  243.     Result := 0;
  244.     if root.Prev <> nil then
  245.       Result := Result + WalkTreeLength(len,hits,root.Prev);
  246.     if (len = 0) or (Length(root.Node.Keyword) = len) then
  247.       if (Pages(root.node.URLs) <= hits) then
  248.         Result := Result + 1;
  249.     if root.Next <> nil then
  250.       Result := Result + WalkTreeLength(len,hits,root.Next)
  251.   end {WalkTreeLength};
  252.  
  253. var
  254.   i,j,k,l: Integer;
  255.   Str: ShortString;
  256.   PageFile: Text;
  257.   IndexFile: TIndexFile;
  258.  
  259. type
  260.   TWhoAmI = (drbob42_com, intranet);
  261. var
  262.   WhoAmI: TWhoAmI;
  263. initialization
  264.   StartTime := timeGetTime;
  265.   Str := ParamStr(0);
  266.   if Pos('D:\INTRANET',UpperCase(STR)) = 1 then { intranet }
  267.   begin
  268.     WhoAmI := intranet;
  269.     Str := 'http://www.bolesian.nl/groups/delphi/drbob42';
  270.     ChDir('groups\delphi\drbob42')
  271.   end
  272.   else { real internet }
  273.   begin
  274.     WhoAmI := drbob42_com;
  275.     Str := 'http://www.drbob42.com';
  276.     ChDir('..')
  277.   end;
  278.   writeln('content-type: text/html');
  279.   writeln;
  280.   writeln('<HTML>');
  281.   writeln('<BODY BACKGROUND="/gif/back.gif">');
  282.   writeln('<H2>IndexBob</H2>');
  283.   writeln('Dr.Bob''s Website Parser version 2.01 - 1998/01/06');
  284.   writeln('<P>Creating index for: www.drbob42.com');
  285.   if WhoAmI = intranet then writeln('(intranet)');
  286.   writeln('<P>');
  287.   writeln('<UL>');
  288.   ScanPages(Str);
  289.   writeln('</UL>');
  290. {$IFDEF ANALYSE}
  291.   writeln('<P>');
  292.   writeln('<TABLE BORDER>');
  293.   write('<TR><TD BGCOLOR=ABC789>Len.</TD>');
  294.   j := 1;
  295.   repeat
  296.     write('<TD BGCOLOR=A7B7C7>',j,'</TD>');
  297.     j := j + j
  298.   until j > MaxHits;
  299.   writeln('<TD BGCOLOR=A7B7C7>',MaxHits,'</TD><TD BGCOLOR=A7B7C7>255</TD><TD BGCOLOR=A7B7C7>Total</TD></TR>');
  300.   for i:=1 to MaxKeyWord do
  301.   begin
  302.     write('<TR><TD BGCOLOR=ABC789>',i,'</TD>');
  303.     j := 1;
  304.     l := 0;
  305.     repeat
  306.       k := l;
  307.       l := WalkTreeLength(i,j,root);
  308.       write('<TD>',l-k,'</TD>');
  309.       j := j + j
  310.     until j > MaxHits;
  311.     k := l;
  312.     l := WalkTreeLength(i,MaxHits,root);
  313.     writeln('<TD>',l-k,'</TD>');
  314.     k := l;
  315.     l := WalkTreeLength(i,255,root);
  316.     writeln('<TD>',l-k,'</TD><TD>',l,'</TD></TR>');
  317.   end;
  318.   write('<TR><TD BGCOLOR=ABC789>Total</TD>');
  319.   j := 1;
  320.   l := 0;
  321.   repeat
  322.     k := l;
  323.     l := WalkTreeLength(0,j,root);
  324.     write('<TD>',l-k,'</TD>');
  325.     j := j + j
  326.   until j > MaxHits;
  327.   k := l;
  328.   l := WalkTreeLength(0,MaxHits,root);
  329.   writeln('<TD>',l-k,'</TD>');
  330.   k := l;
  331.   l := WalkTreeLength(0,255,root);
  332.   writeln('<TD>',l-k,'</TD><TD>',l,'</TD></TR>');
  333.   writeln('</TABLE>');
  334.   writeln('<P>');
  335. {$ENDIF}
  336.   if WhoAmI = intranet then ChDir('\intranet\cgi_bin')
  337.                        else ChDir('cgi-bin');
  338.   if IOResult <> 0 then { skip };
  339.   assign(IndexFile,'index.bob');
  340.   if root <> nil then
  341.   try
  342.   {$IFDEF BLOCK}
  343.     rewrite(IndexFile,1);
  344.   {$ELSE}
  345.     rewrite(IndexFile);
  346.   {$ENDIF}
  347.     Keywords := 0; { real counter }
  348.     writeln('Skipped common keywords:');
  349.     writeln('<OL>');
  350.     WriteTree(IndexFile,root);
  351.     writeln('</OL>')
  352.   finally
  353.     close(IndexFile)
  354.   end;
  355.   assign(PageFile,'pages.bob');
  356.   try
  357.     rewrite(PageFile);
  358.     for i:=0 to WebPages-1 do
  359.       writeln(PageFile,WebPage[i]);
  360.   {$IFDEF BLOCK}
  361.     writeln(PageFile,KeyWords)
  362.   {$ENDIF}
  363.   finally
  364.     close(PageFile)
  365.   end;
  366.   assign(PageFile,'title.bob');
  367.   try
  368.     rewrite(PageFile);
  369.     for i:=0 to WebPages-1 do
  370.       writeln(PageFile,Titles[i]);
  371.   finally
  372.     close(PageFile)
  373.   end;
  374.   writeln('<HR>');
  375.   writeln('<FONT SIZE=1>');
  376.   writeln('Webpages: ',WebPages);
  377.   writeln('<BR>Keywords: ',Keywords);
  378.   writeln('<BR>Index Time: ',(timeGetTime-StartTime)/1000:1:2,' sec.');
  379.   writeln('</FONT>');
  380.   writeln('<HR>');
  381.   writeln('</BODY>');
  382.   writeln('</HTML>')
  383. finalization
  384.   root.Free
  385. end.
  386.